home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / info-service / archie / software / filt.pl < prev    next >
Encoding:
Perl Script  |  1992-06-17  |  11.1 KB  |  374 lines
  1. #!/usr/local/bin/perl
  2. # This program filters raw ls listings files to produce a file that archie
  3. # can parse.  It started life as the filt program in the original archie
  4. # distribution and was converted to perl and modified by Amos Shapira.
  5. # Then significant modifications and improvements, as well as many hours of
  6. # testing, were done by Eric Anderson at SURAnet (eanders@sura.net).
  7. #
  8. # Please report any bugs or send any patches to archie-admin@sura.net
  9. # Also regular expression gurus should feel free to comment what various
  10. # undocumented sections of the code actually does.
  11. #
  12. # Notes:
  13. # Need to add to fixpermerrors a check for whatever stupid thing the site
  14. # is sticking onto the front.
  15. # SITES we do not handle yet:
  16. # eba.eb.ele.tue.nl 
  17. # harvard.harvard.edu
  18. # biox.unibas.ch
  19. # garbo.uwasa.fi
  20. # inria.inria.fr
  21. # thumper.bellcore.com
  22. # Filter version 1.0.4
  23. $debuglevel=0;
  24.                 # Debuglevels:
  25. $\ = "\n";        # automatically add newline on print
  26. @legit = ("[dl-]","[r-]","[w-]","[xsS-]","[r-]","[w-]",
  27.       "[xsS-]","[r-]","[w-]","[x-]",
  28.       "(\\d| )","(\\d| )","(\\d| )","[ \\d\\w]","[ \\d\\w]");
  29. #for ($loop=
  30. # Legit patterns for chars in permission part of line.
  31.  
  32. $fulllegit = join("",@legit);
  33. $aixlegit = join("","^[DF]",@legit[1..9]);
  34. $dirperms = join("",'d',@legit[1..9]);
  35. $permlegit = join("","^",@legit[0..9]);
  36. $idlegit = "^(\\w|\\d|-)+$";
  37. #print "'$dirperms'";
  38. $badchar = "[^ -~\\t]";
  39. $corruptpattern = join('',$badchar,".*",$badchar,".*",$badchar,".*");
  40. $filenamebegin= -1;     # Automagically initialized on the first directory.
  41. $printedaline=0;
  42. $maxdiraddsize=40;
  43. $curdir="";
  44. undef @basedirs;
  45. $lastline="@@@beginning";
  46.  
  47. for (;<>;) {
  48.     chop;
  49. # Commented out study because it was making some stuff break, I don't
  50. # quite know why, below is code which breaks if it is below the study.
  51. #    print "$_";
  52. #    print "MOOOOF" if /$dirperms/o;
  53. #    next;
  54. #    study;
  55.  
  56.     die ("@@@ Belch -- Corrupted input?\n") if /$corruptpattern/o;
  57.  
  58. # If any of these cases are true, the line is not printed.
  59.     
  60. # Remove totaling lines
  61.     next if (/^total[ \t]+\d+[ \t]*$/o);
  62.     next if (/^Total:[ \t]+\d+[ \t]*kbytes$/o);
  63. # Something with opendir in it.
  64.     next if (/^opendir:/o);# {
  65. # Toss we are in europe lines
  66.     next if (/WE ARE IN EUROPE/o);
  67. # Don't print character or block devices.
  68.     next if (/[cb][-rwxSsTt]{9}/o);
  69. # Chuck lines having that pattern in them.
  70.     next if (/can not access/o);
  71. # Chuck lines as seen below.
  72.     next if (/stale nfs file handle/io);
  73. # Another bizarre case
  74.     next if (/^\.:?$/o);
  75. # Throw away leading blank lines
  76.   next if (/^$/ && !$printedaline);
  77. # I wonder what this does.
  78.     next if (/^[ \t]/o);
  79. # Throw away lines containing unreadable.
  80.     next if (/unreadable/o);
  81. # Throw away lines which have : no /dev/zero at the end of them
  82.     next if (/: no \/dev\/zero$/o);
  83. # Throw away lines which have No such file or directory in them
  84.     next if (/No such file or directory$/o);
  85. # Throw away lines with crt0: no /usr/lib/ld.so -- for sparta.spartacus.com
  86.     next if (/^crt0: no \/usr\/lib\/ld.so$/o);
  87. # Throw away short lines which aren't blank and aren't directories.
  88. # First seen on cs.tut.fi
  89.     next if ((length($_)<10)&&(!/:$/o)&&(!/^$/o)&&!(/^\.|\//o));
  90.     next if ((length($_)<$filenamebegin) && /^$fulllegit/o &&
  91.          !(/Permission denied/o||/not found/o||/cannot access/o));
  92. # Throw away ld.so warnings
  93.     next if (/^ld.so: warning: /o);
  94. # Throw away more ld.so errors
  95.     next if (/^ld.so: map heap error \(22\) for \/dev\/zero/o);
  96. # Throw away the line ${org}: for eba.eb.ele.tue.nl
  97.     next if (/^\$\{org\}\:$/o);
  98. # Throw away lines with connection timed out for ftp.informatik.rwth-aachen.de
  99.     next if (/^ls:.*Connection timed out$/o);
  100. # Throw away this line for aix370.rrz.uni-koeln.de
  101.     next if (/^\.disk1\:$/o);
  102. # Remove blank lines which precede filename entries so that enter doesn't
  103. # think they are supposed to be directory names.
  104.     if (/^$/o) {
  105.     $_ = <STDIN>;
  106. #    print STDERR "$_";        # ***
  107.     last if !defined $_;
  108.     chop;
  109.     if (!/^$fulllegit/o) {
  110.         print "";
  111.         $lastline = "";
  112.         $_ .= " ";        # For the chop to eat.
  113.         redo;
  114.     } 
  115.     }
  116.     
  117.     if ($filenamebegin<0&&/^$dirperms/o) {
  118.     $filenamebegin = length($_);
  119.     do {
  120.         --$filenamebegin;
  121.         die ("filenamebegin dropped too much??") if $filenamebegin<20;
  122.     } until ((substr($_,$filenamebegin,1) eq " ")&&
  123.          (substr($_,$filenamebegin-2,1) =~ /\d/o));
  124.     ++$filenamebegin;
  125.     }
  126. # Make sure we don't get stuck in a loop.
  127.     $count=0;
  128.     $start=$_;
  129. # This forces idempotency. the loop that is.
  130.     do {
  131.     ++$count;
  132.     die("@@@ iterated for a long time on \n'$start'\n, never got done.\n") if $count>50;
  133. #    warn("@@@ iterations:$count") if $count>2;
  134.     $orig = $_;
  135. # Try to put : after dir names in listing.
  136. # bin:
  137. # files
  138.     
  139.     if ((/^\./o || /^\//o) && /\w$/o  && !/Permission denied/o) {
  140.         print "";
  141.         $lastline = "";
  142.         $_ = "$_:";
  143.     }
  144. # Dump a return in if the last line was all printable chars with a colon
  145. # on the end, e.g. a directory, and the last line was for real.
  146.     if (!/^$fulllegit/o) {
  147.         print "" if (/^[\w\/+#-\.]+:$/o && $lastline);
  148. # Remove an extra color from a directory name entry if it exists.
  149. # For wuarchive.wustl.edu
  150.         s/::$/:/o;
  151.     }
  152.  
  153. #General cleanup
  154. # Hack out garbage people put on front of listings.
  155.     if (/^\//o || /^\./o) {
  156.         s!^\./!!o;
  157.         s!^/usr/spool/ftp/!!o;
  158.         s!^/pub/!!o;
  159.         s!^/usr/local/pub/!!o;
  160.         s!^/home/ftp/pub/!!o;
  161.         s!^/ftp/pub/!!o;
  162.         s!^/com/ftp/pub/!!o;
  163.         s!^/var/spool/uucppublic/!!o;
  164.         s!^/com/ftp/sun4/pub/!!o;
  165.         s!^/users/ftp/!!o;
  166.         s!^.disk1/!!o; # For aix370.rrz.uni-koeln.de
  167.     }
  168.  
  169. # What's this do?
  170. #    s/^([-dl][-rwxSsTt]{9}.*)(\\$)/$1/o; 
  171. #    s/^([-dl][-rwxSsTt]{9})(\d+)/$1 $2/o; 
  172. # Take out trailing / from directory listing
  173.     s/^(d.*)\/$/$1/o;
  174. # Take :'s off the end of lines which aren't really directories names.
  175. # Why would I want to do this? Note I still do.
  176. # Do this so that the next line will work right.
  177.     s/^($fulllegit.*)\:$/$1/o;
  178. # Hack for walhalla.informatik.uni-dortmund.de, user/group names with
  179. # spaces in them.
  180.     s/NOT FTP/NOT_FTP/go;
  181. # Hack for gargoyle.uchicago.edu, to fix directory with return in the name
  182.     if (/^pub\/emwq\/Mailboxes.*h$/o) {
  183.         $_ .= ":";
  184.         $foo = <STDIN>;
  185.     }
  186. # Two hacks for eba.eb.ele.tue.nl
  187.     if (/^l.*local.$/o) {
  188.         s/^l(.*local)./d$1/o;
  189.     }
  190.     if (/^pub\/apollo\/local\/News\:$/o) {
  191.         print "pub/apollo/local:";
  192.         print "drwxrwxrwx   1 news           15 Mar 15 12:00 News";
  193.         print "";
  194.     }
  195.  
  196. #Put space between permissions and id.
  197.     if (/^[ld-][r-][w-][x-]/o && /^..........\d/o) {
  198.         s/^(..........)/$1 /o;
  199.         if (substr($_,$filenamebegin-1,2) eq '  ') {
  200.         substr($_,$filenamebegin-1,2) = ' ';
  201.         }
  202.     }
  203.  
  204. #Fix AIX bogosity
  205.     if (/$aixlegit/o) {
  206.             # Aix ls follows directory symlinks.
  207.         s/ \-\> .*$//o if (/^D/o && / \-\> /o);
  208.         s/^D/d/o;
  209.         s/^F/-/o;
  210.     }
  211. #Special hack for earth.rs.itd.umich.edu
  212.     if (/^mac\.bin\/\.AppleDesktop\/_:$/o && !$hack'umich_edu) {
  213. #        print STDERR "@Did hack for earth on $_."; # ***
  214.         $hack'umich_edu=1;
  215.         while(!/^$/o) {
  216.         $_=<STDIN>;
  217.         }
  218.     }
  219.  
  220. #Replace trailing spaces with underscores in directory listings.
  221.     $spacepos=rindex($_," ");
  222.     while (($spacepos>=$filenamebegin)
  223.           &&((/ _*$/o)||
  224.          (substr($_,$filenamebegin-6) =~ /^(\d| )\d(\d|\:)\d\d _* /o))) {
  225.         # Roughly that regexp is time (13:45) or year ( 1990)
  226.         s/ (_*)$/_$1/o;
  227.         substr($_,$filenamebegin-6) =~
  228.         s/^(..... )(_*) /$1$2_/o;
  229.         $spacepos=rindex($_," ");
  230.     }
  231. #Put in leading spaces for bogus stuff.
  232. #Ditto for the : terminated stuff.
  233. # Also fixup anthing like foo/bar /doobie:
  234.     if (/:$/o) {
  235.         s/ (_*(:$|\/))/_$1/o while (/ _*(:$|\/)/o);
  236.         s/\/(_*) /\/_$1/o while (/\/_* /o);
  237.     }
  238.  
  239. #Complicated fixups.
  240.     if (/Permission denied/o||/not found/o||/cannot access/o||
  241.         /Connection timed out/o) {
  242.         $_ = &fixlserrors($_);
  243.         next if (! $_);
  244.     }
  245.     } until ($orig eq $_);
  246.  
  247.     if (/^$dirperms/o) { # && length($_)<$maxdiraddsize) {
  248.     $dirname=$curdir . substr($_,$filenamebegin);
  249.     if (length($dirname) <$maxdiraddsize) {
  250.         push(@basedirs,$dirname);
  251. #        print STDERR "Adding '",$dirname,"' to dir list";
  252.     }
  253.     }
  254.     $curdir = substr($_,0,length($_)-1)."/" if (/:$/o);
  255.  
  256.     $lastline = $_;
  257.     print;
  258.     $printedaline=1;
  259. }              
  260.     
  261. sub fixlserrors {
  262.     local ($_) = @_;
  263.     local ($first);
  264.     local ($count);
  265.  
  266. #    print STDERR "Enter FixLsErrors";
  267. #    return "" if /^ls.*denied$/o;
  268.     return "" if /^(\/bin\/)?ls.*denied$/o;
  269. #    return "" if /^ls.*not found$/o;
  270.     return "" if /^(\/bin\/)?ls.*not found$/o;
  271.     return "" if /^cannot access /o;
  272.     return "" if /^lost\+found: Permission denied$/o;
  273. #    $foodebug=1 if $_ =~ /tesol: Per/;
  274.     $first = &fixpermline($_);
  275. #    print STDERR "*1$first" if $foodebug;
  276.     $count = 0;
  277.     $_ = undef;
  278.     while (!$_) {
  279. #    print STDERR "Hi";
  280.     ++$count;
  281.     die ("@@@ FixLsErrors iterated too long :$count\n") if $count>200;
  282.     $_ = <STDIN>;
  283.     last if !defined($_);
  284. #    print STDERR "*a$count,$first,$_"; #***
  285. #    print STDERR "'$_'" if defined $_;
  286.     chop ;
  287.     last if /^$/o;
  288. #    print STDERR "*b$count,$first,$_"; #***
  289.         if (/denied$/o) {
  290.         $_ = "";
  291.     } else {
  292.         $_ = &fixpermline($_);
  293.     }
  294. #    print STDERR "*c$count,$first,$_"; #***
  295.     }
  296. #    print STDERR "*d$first" if $foodebug;
  297. #    print STDERR "@*$first,$_" if /pleD/o;
  298. #    print STDERR "*e$first" if $foodebug;
  299.     $_= $first . $_;
  300. #    print STDERR "*&&$_" if $foodebug;
  301.     return $_ if /^$fulllegit/o;
  302.     return $_ if /^.*:$/o;
  303.     return "";
  304. }
  305.     
  306. sub fixpermline {
  307.     local ($_) = @_;
  308.     local ($count);
  309.  
  310. #    print "@$_@";
  311. # sys13 stuff for potemkin.cs.pdx.edu
  312.     s/(\/bin\/)?ls\s*:.*denied( \(sys13\))?$//o;
  313.     s/(\/bin\/)?ls\s*:.*not found$//o;
  314.     s/\.\/.*not found$//o;
  315.     s/cannot access .*$//o;
  316.     s/\.\/.*Connection timed out:$//o;
  317. #    print STDERR "*$_*";
  318.     return $_ if !(/Permission denied/o || /not found/o || /cannot access/o ||
  319.            /Connection timed out/o);
  320.  
  321.     $rightmost=0;
  322.     $longlen=0;
  323.     foreach $elem (@basedirs) {
  324. #    if ($foodebug&&rindex($_,$elem)>=0) {
  325. #        print STDERR "@$elem";
  326. #        print STDERR "@$elem,", rindex($_,$elem);
  327. #        print STDERR "@", rindex($_,"mac/incoming");
  328. #    }
  329.     if (0<=($foo=rindex($_,$elem))) {
  330.         $bar = length($elem);
  331. #        print STDERR "@@$foo,$rightmost,$bar,$longlen,", $rightmost-$bar-1;
  332.         if ($foo>=($rightmost-$bar-1)) {
  333.         # Backup by at most by the length of the current one.
  334.         # Plus a /
  335.         $longlen=$bar;
  336.         $rightmost=$foo;
  337. #        print STDERR "!$_,$elem,$longlen,$rightmost" if /incoming\/pal/;
  338.         }
  339.     }
  340.     }
  341. #    if ($rightmost>0&&$foodebug) {
  342. #    print STDERR "Found:", substr($_,$rightmost);
  343. #    print STDERR "Returning:" , substr($_,0,$rightmost);
  344. #    }
  345.     if (/$fulllegit/o) {
  346.     $_ = substr($_,0,$rightmost);
  347.     } else {
  348.     return substr($_,0,$rightmost) if (($rightmost>0) && 
  349.                       !(substr($_,$rightmost-1,1) eq "/"));
  350. #    print STDERR "nope";
  351.     }
  352.  
  353.     local($acc,$orig) = ("",$_);
  354.     local(@line) = split(//o,$_);
  355.     local($x,$m);
  356.     local(@legitcopy) = @legit;
  357.  
  358.     $count=0;
  359.     do {
  360.     ++$count;
  361.     die ("@@@ fixpermline iterated too long:$count\n") if $count>50;
  362.     $_ = shift @line;
  363.     $m = shift @legitcopy;
  364. #    print STDERR "#$m#$_#$acc";
  365.     return $acc if !/$m/;    # Don't put the o here, this changes.
  366. #    print STDERR "##$acc";
  367.     $acc .= $_;
  368.     } until $#legitcopy==-1;
  369.     $_=$orig;
  370.     s/\:\s*Permission denied//o;
  371.     s/\/(\w|\/)*\s*not found//o;
  372.     return $_;
  373. }
  374.